home *** CD-ROM | disk | FTP | other *** search
Wrap
(*************************************************** Ant Movie Catalog importation script www.antp.be/software/moviecatalog/ [Infos] Authors=japg2000 (japg2000@terra.es) Title=CaratulasDeCine Description=Picture importation script for www.caratulasdecine.com Site=www.caratulasdecine.com Language=ES Version=1.1 Requires=3.5.0 Comments= License=The source code of the script can be used in another program only if full credits to script author and a link to Ant Movie Catalog website are given in the About box or in the documentation of the program.| GetInfo=1 [Options] ***************************************************) program CaratulasdecineImport; var Title: string; function FindLine(Pattern: string; List: TStringList; StartAt: Integer): Integer; var i: Integer; begin result := -1; if StartAt < 0 then StartAt := 0; for i := StartAt to List.Count-1 do if Pos(Pattern, List.GetString(i)) <> 0 then begin result := i; Break; end; end; function EliminaInicio(S: string; CR: string): string; begin result := S; while Pos(CR, result) = 1 do begin Delete(result, 1, Length(CR)); end; end; function CadenaEntre(var S: string; StartTag: string; EndTag: string): string; var InicioPos: Integer; begin InicioPos := Pos(StartTag, S); Delete(S, 1, InicioPos + Length(StartTag) - 1); InicioPos := Pos(EndTag, S); result := copy(S, 1, InicioPos - 1); Delete(S, 1, InicioPos + 1); end; function PreparaTitulo(T: string): string; var i: Integer; begin result := AnsiLowerCase(T); HTMLDecode(result); result := StringReplace(result, chr(146), ''); result := StringReplace(result, chr(39), ''); result := StringReplace(result, '┤', ''); result := StringReplace(result, '`', ''); result := StringReplace(result, '"', ''); result := StringReplace(result, '┐', ''); result := StringReplace(result, '?', ''); result := StringReplace(result, 'í', ''); result := StringReplace(result, '!', ''); result := StringReplace(result, '.', ''); result := StringReplace(result, ',', ''); result := StringReplace(result, ':', ''); result := StringReplace(result, ';', ''); result := StringReplace(result, '-', ''); result := StringReplace(result, '/', ''); result := StringReplace(result, '\', ''); result := StringReplace(result, 'ß', 'a'); result := StringReplace(result, 'Θ', 'e'); result := StringReplace(result, 'φ', 'i'); result := StringReplace(result, '≤', 'o'); result := StringReplace(result, '·', 'u'); result := StringReplace(result, 'ⁿ', 'u'); result := StringReplace(result, '±', 'n'); end; function GetCaratulasDeCineDir(MovieTitle: string): string; var PageOfLetter: Array of string; C: Char; Index: Integer; begin Setarraylength(PageOfLetter,36); PageOfLetter[0]:='0_9'; PageOfLetter[1]:='0_9'; PageOfLetter[2]:='0_9'; PageOfLetter[3]:='0_9'; PageOfLetter[4]:='0_9'; PageOfLetter[5]:='0_9'; PageOfLetter[6]:='0_9'; PageOfLetter[7]:='0_9'; PageOfLetter[8]:='0_9'; PageOfLetter[9]:='0_9'; PageOfLetter[10]:='a'; PageOfLetter[11]:='b'; PageOfLetter[12]:='c'; PageOfLetter[13]:='d'; PageOfLetter[14]:='e'; PageOfLetter[15]:='f_h'; PageOfLetter[16]:='f_h'; PageOfLetter[17]:='f_h'; PageOfLetter[18]:='i_k'; PageOfLetter[19]:='i_k'; PageOfLetter[20]:='i_k'; PageOfLetter[21]:='l'; PageOfLetter[22]:='m_n'; PageOfLetter[23]:='m_n'; PageOfLetter[24]:='o_q'; PageOfLetter[25]:='o_q'; PageOfLetter[26]:='o_q'; PageOfLetter[27]:='r_s'; PageOfLetter[28]:='r_s'; PageOfLetter[29]:='t_z'; PageOfLetter[30]:='t_z'; PageOfLetter[31]:='t_z'; PageOfLetter[32]:='t_z'; PageOfLetter[33]:='t_z'; PageOfLetter[34]:='t_z'; PageOfLetter[35]:='t_z'; C := copy(MovieTitle, 1, 1); if (C >= '0') and (C <= '9') then begin Index := Ord(C) - Ord('0'); end else begin Index := 10 + Ord(C) - Ord('a'); end; result:='http://www.caratulasdecine.com/' + PageOfLetter[Index] + '.htm'; end; procedure AnalyzePageCaratulasDeCine(PageDir: string); var CaratulasdecinePage, MoviePage: TStringList; MovieDir, Line, LineTmp: string; Encontrado, Salir, BeginPos, EndPos, LineNr, LineMov: Integer; begin CaratulasdecinePage := TStringList.Create; CaratulasdecinePage.Text := GetPage(PageDir); LineNr := FindLine('</big></big></big></big></big></big>', CaratulasdecinePage, 0); LineNr := LineNr + 1; Line := CaratulasdecinePage.GetString(LineNr); Line := EliminaInicio(Line, ' '); Salir := 0; Encontrado := 0; repeat while (Pos('<br>', Line) = 0) and (Pos('</td>', Line) = 0) and (LineNr < 1000) do begin if copy(Line, Length(Line), 1) <> ' ' then Line := Line + ' '; LineNr := LineNr + 1; LineTmp := CaratulasdecinePage.GetString(LineNr); LineTmp := EliminaInicio(LineTmp, ' '); Line := Line + LineTmp; end; if Pos('</td>', Line) > 0 then Salir := 1; if Pos('<a class="A" href="', Line) > 0 then begin MovieDir := 'http://www.caratulasdecine.com/' + CadenaEntre(Line, '<a class="A" href="', '">'); end else begin MovieDir := Line; MovieDir := CadenaEntre(MovieDir, '<a href="', 'class="A">'); while Pos('<a href="', MovieDir) > 0 do MovieDir := CadenaEntre(MovieDir, '<a href="', 'class="A">'); end; Line := CadenaEntre(Line, '', '<'); Line := PreparaTitulo(Line); if Pos(Title, Line) > 0 then begin MoviePage := TStringList.Create; MoviePage.Text := GetPage(MovieDir); LineMov := FindLine('<p align="center"><img src="', MoviePage, 0); Line := MoviePage.GetString(LineMov); Line := CadenaEntre(Line, '<p align="center"><img src="', '" '); Line := EliminaInicio(Line, '../'); GetPicture('http://www.caratulasdecine.com/' + Line); Salir := 1; Encontrado := 1; end; LineNr := LineNr + 1; if LineNr > 1000 then Salir := 1; Line := CaratulasdecinePage.GetString(LineNr); Line := EliminaInicio(Line, ' '); until Salir = 1; if (Encontrado <> 1) then ShowMessage('Titulo ' + Title + ' no encontrado en ' + PageDir) end; begin if CheckVersion(3,5,0) then begin Title := GetField(fieldTranslatedTitle); if Title = '' then Title := GetField(fieldOriginalTitle); Title := PreparaTitulo(Title); Input('Importar de caratulasdecine.com', 'Por favor, introduce el titulo:', Title); Title := PreparaTitulo(Title); AnalyzePageCaratulasDeCine(GetCaratulasDeCineDir(Title)); end else ShowMessage('Este script necesita una versi≤n superior de Ant Movie Catalog (al menos la version 3.5.0)'); end.